home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 4 NO 1.st / POGOSRC.ARC / POGOCODE.C < prev    next >
Encoding:
C/C++ Source or Header  |  1985-11-20  |  13.1 KB  |  598 lines
  1.  
  2. /* Pogocode.c - most of what is done by the run-time pogo interpreter,
  3.    and some little functions used by the code generator.  Also here's
  4.    where we do constant folding for some reason... */
  5.  
  6. #include <stdio.h>
  7. #include "pogo.h"
  8. #include "dlist.h"
  9.  
  10.  
  11. int active_frame;
  12. struct func_frame *strace[RMAX];
  13. Names *temps[RMAX];
  14. int watchdog;
  15.  
  16. check_stack(fuf)
  17. struct func_frame *fuf;
  18. {
  19. if (active_frame >= RMAX-1)
  20.     {
  21.     runtime_err("Recursion too deep");
  22.     return(0);
  23.     }
  24. strace[active_frame++] = fuf;
  25. return(1);
  26. }
  27.  
  28. /* Interpret code stream - yer basic software simulated stack based 
  29.    microprocessor */
  30. void *
  31. run_ops(op, ostack)
  32. struct pogo_op *op;
  33. register union pt_int *ostack;
  34. {
  35. register union pt_int *stack;
  36. struct slist *s;
  37. struct func_frame *fuf;
  38. Names *n;
  39. int t;
  40.  
  41. stack = ostack;
  42. for (;;)
  43.     {
  44.     if (--watchdog <= 0)
  45.         {
  46.         watchdog = 200;
  47. #ifdef LATER
  48.         if (stack < ostack )
  49.             {
  50.             run_abort = 1;
  51.             puts("Stack underflow");
  52.             break;
  53.             }
  54.         if ( stack > dstack_buf+1000)
  55.             {
  56.             run_abort = 1;
  57.             puts("Stack overflow");
  58.             break;
  59.             }
  60. #endif LATER
  61.         check_abort();
  62.         }
  63.     if (user_abort || run_abort)
  64.         {
  65.         if (run_abort || user_abort == 2)
  66.             {
  67.             dump_state(op, stack, ostack);
  68.             user_abort = run_abort = 0;
  69.             }
  70.         if (user_abort == 1)
  71.             return(NULL);
  72.         }
  73.     switch (op->type)
  74.         {
  75.         case OP_CON:    /* push a constant onto data stack */
  76.             stack->p =  op->data.p;
  77.             stack++;
  78.             break;
  79.         case OP_VAR:    /* push a variable onto data stack */
  80.         case OP_SVAR:    /* push a variable onto data stack */
  81.             stack->p = dstack_buf[op->data.i].p;
  82.             stack++;
  83.             break;
  84.         case OP_LVAR:    /* push a local variable onto data stack */
  85.         case OP_LSVAR:
  86.             stack->p = ostack[op->data.i].p;
  87.             stack++;
  88.             break;
  89.         case OP_ARR:    /* put an element of an array onto data stack */
  90.         case OP_SARR:    /* put an element of an array onto data stack */
  91.             stack[-1].p = dstack_buf[op->data.i + stack[-1].i].p;
  92.             break;
  93.         case OP_LARR:    /* put an element of a local array onto stack */
  94.         case OP_LSARR:    /* put an element of a local array onto stack */
  95.             stack[-1].p = ostack[op->data.i + stack[-1].i].p;
  96.             break;
  97.     #ifdef LATER
  98.         case OP_SVAR:    /* push a string variable onto data stack */
  99.             stack->p = dstack_buf[op->data.i].p;
  100.             stack++;
  101.             break;
  102.         case OP_LSVAR:    /* push a local string variable onto data stack */
  103.             s = ostack[op->data.i].p;
  104.             stack->p = s->string;
  105.             stack++;
  106.             break;
  107.         case OP_SARR:    /* put an element of a string array onto data stack */
  108.             s = dstack_buf[op->data.i + stack[-1].i].p;
  109.             stack[-1].p = s->string;
  110.             break;
  111.         case OP_LSARR:    /* put an element of a string array onto data stack */
  112.             s = ostack[op->data.i + stack[-1].i].p;
  113.             stack[-1].p = s->string;
  114.             break;
  115.     #endif LATER
  116.         case OP_ADD:    /* replace top two elements of stack one result */
  117.             stack[-2].i += stack[-1].i;
  118.             stack -= 1;
  119.             break;
  120.         case OP_SUB:    /* replace top two elements of stack one result */
  121.             stack[-2].i -= stack[-1].i;
  122.             stack -= 1;
  123.             break;
  124.         case OP_MUL:    /* replace top two elements of stack one result */
  125.             stack[-2].i *= stack[-1].i;
  126.             stack -= 1;
  127.             break;
  128.         case OP_DIV:    /* replace top two elements of stack one result */
  129.             stack[-2].i /= stack[-1].i;
  130.             stack -= 1;
  131.             break;
  132.         case OP_MOD:    /* replace top two elements of stack one result */
  133.             stack[-2].i %= stack[-1].i;
  134.             stack -= 1;
  135.             break;
  136.         case OP_BOR:    /* replace top two elements of stack with binary or*/
  137.             stack[-2].i |= stack[-1].i;
  138.             stack -= 1;
  139.             break;
  140.         case OP_BAND:    /* replace top two elements with binary and */
  141.             stack[-2].i &= stack[-1].i;
  142.             stack -= 1;
  143.             break;
  144.         case OP_BXOR:    /* replace top two elements with binary xor */
  145.             stack[-2].i ^= stack[-1].i;
  146.             stack -= 1;
  147.             break;
  148.         case OP_LSHIFT: 
  149.             stack[-2].i <<= stack[-1].i;
  150.             stack -= 1;
  151.             break;
  152.         case OP_RSHIFT: 
  153.             stack[-2].i >>= stack[-1].i;
  154.             stack -= 1;
  155.             break;
  156.         case OP_LAND:
  157.             stack[-2].i = stack[-2].i && stack[-1].i;
  158.             stack -= 1;
  159.             break;
  160.         case OP_LOR:
  161.             stack[-2].i = stack[-2].i || stack[-1].i;
  162.             stack -= 1;
  163.             break;
  164.         case OP_NEG:    /* negate top of stack */
  165.             stack[-1].i = -stack[-1].i;
  166.             break;
  167.         case OP_BNOT:    /* binary not top of stack */
  168.             stack[-1].i = ~stack[-1].i;
  169.             break;
  170.         case OP_LNOT:    /* logical not top of stack */
  171.             stack[-1].i = !stack[-1].i;
  172.             break;
  173.  
  174.  
  175.         /* String assigns */
  176.         case OP_SASSIGN:    /* global string assignment */
  177.             --stack;
  178.             t = op->data.i;
  179.             gentle_free(dstack_buf[t].p);
  180.             dstack_buf[t].p = clone_string(stack->p);
  181.             break;
  182.         case OP_CSASSIGN:    /* local creature string assignment*/
  183.             --stack;
  184.             t = op->data.i;
  185.             gentle_free(ostack[t].p);
  186.             ostack[t].p = clone_string(stack->p);
  187.             break;
  188.         case OP_LSASSIGN: /* local function string assignment*/
  189.             --stack;
  190.             ostack[op->data.i].p = stack->p;
  191.             break;
  192.         case OP_ASASSIGN:    /* global string array assigment*/
  193.             t = op->data.i + stack[-2].i;
  194.             gentle_free(dstack_buf[t].p);
  195.             dstack_buf[t].p = clone_string(stack[-1].p);
  196.             stack -= 2;
  197.             break;
  198.         case OP_CASASSIGN:    /* creature string array assigment*/
  199.             t = op->data.i + stack[-2].i;
  200.             gentle_free(ostack[t].p);
  201.             ostack[t].p = clone_string(stack[-1].p);
  202.             stack -= 2;
  203.             break;
  204.         case OP_LASASSIGN: /* local string array assignment */
  205.             ostack[op->data.i+stack[-2].i].p = stack[-1].p;
  206.             stack -= 2;
  207.             break;
  208.  
  209.         case OP_ASSIGN:    /* pop top of stack into a variable */
  210.             --stack;
  211.             dstack_buf[op->data.i].p = stack->p;
  212.             break;
  213.         case OP_LASSIGN: /* pop top of stack into a local variable */
  214.             --stack;
  215.             ostack[op->data.i].p = stack->p;
  216.             break;
  217.         case OP_AASSIGN:    /* pop top of stack into a variable */
  218.             dstack_buf[op->data.i+stack[-2].i].p = stack[-1].p;
  219.             stack -= 2;
  220.             break;
  221.         case OP_LAASSIGN: /* pop top of stack into a local variable */
  222.             ostack[op->data.i+stack[-2].i].p = stack[-1].p;
  223.             stack -= 2;
  224.             break;
  225.         case OP_CHECK:        /* make sure an array ref isn't out of bounds */
  226.             t = stack[-1].i;
  227.             if (t < 0)
  228.                 {
  229.                 char buf[80];
  230.  
  231.                 sprintf(buf, "Negative array index: %d\n", t);
  232.                 runtime_err(buf);
  233.                 run_abort = 1;
  234.                 }
  235.             else if (t >= op->data.i)
  236.                 {
  237.                 char buf[80];
  238.  
  239.                 to_text();
  240.                 puts("Array index too large");
  241.                 sprintf(buf, "Index %d, max %d\n", t, op->data.i-1);
  242.                 runtime_err(buf);
  243.                 run_abort = 1;
  244.                 }
  245.             break;
  246.         case OP_RETRIEVE:     /* move top of stack elsewhere in stack */
  247.                             /* generated save return value... */
  248.             t = op->data.i;
  249.             stack[t-1].p = stack[-1].p;
  250.             stack += t;
  251.             break;
  252.         case OP_CBRA:    /* pop top of stack and branch if zero */
  253.             --stack;
  254.             if (!stack->i)
  255.                 {
  256.                 op += op->data.i;
  257.                 }
  258.             break;
  259.         case OP_BRA:    /* unconditional branch */
  260.             op += op->data.i;
  261.             break;
  262.         case OP_EQ:        /* pop top 2 el's of stack and push EQ result */
  263.             stack[-2].i = (stack[-2].i == stack[-1].i);
  264.             stack -= 1;
  265.             break;
  266.         case OP_NE:        /* pop tow 2 el's of stack and push NE result */
  267.             stack[-2].i = (stack[-2].i != stack[-1].i);
  268.             stack -= 1;
  269.             break;
  270.         case OP_GT:
  271.             stack[-2].i = (stack[-2].i > stack[-1].i);
  272.             stack -= 1;
  273.             break;
  274.         case OP_LT:
  275.             stack[-2].i = (stack[-2].i < stack[-1].i);
  276.             stack -= 1;
  277.             break;
  278.         case OP_GE:
  279.             stack[-2].i = (stack[-2].i >= stack[-1].i);
  280.             stack -= 1;
  281.             break;
  282.         case OP_LE:
  283.             stack[-2].i = (stack[-2].i <= stack[-1].i);
  284.             stack -= 1;
  285.             break;
  286.         case OP_END:    /* finished instruction stream */
  287.             /* return top of stack */
  288.             return(stack[-1].p);
  289.         case OP_CALLS:    /* call string function pointer */
  290.             fuf = op->data.p;
  291.             if (!check_stack(fuf))
  292.                 break;
  293.             --active_frame;
  294.             add_cr_string(stack->p = clone_string(run_ops(fuf->code,stack+1)));    
  295.             if (temps[active_frame] != NULL)
  296.                 {
  297.                 free_nlist(temps[active_frame]);
  298.                 temps[active_frame] = NULL;
  299.                 }
  300.             stack++;
  301.             break;
  302.         case OP_CALL:    /* call integer function */
  303.             fuf = op->data.p;
  304.             if (!check_stack(fuf))
  305.                 break;
  306.             stack->p = run_ops(fuf->code, stack+1);    
  307.             --active_frame;
  308.             if (temps[active_frame] != NULL)
  309.                 {
  310.                 free_nlist(temps[active_frame]);
  311.                 temps[active_frame] = NULL;
  312.                 }
  313.             stack++;
  314.             break;
  315.         case OP_PCALL:    /* call function no return value */
  316.             fuf = op->data.p;
  317.             if (!check_stack(fuf))
  318.                 break;
  319.             run_ops(fuf->code, stack+1);    
  320.             --active_frame;
  321.             if (temps[active_frame] != NULL)
  322.                 {
  323.                 free_nlist(temps[active_frame]);
  324.                 temps[active_frame] = NULL;
  325.                 }
  326.             break;
  327.         case OP_PPREDEF:    /* call 'C' function no ret value */
  328.             {
  329.             typedef int func();
  330.             func *f;
  331.  
  332.             f = (func *)op->data.p;
  333.             (*f)(stack);
  334.             }
  335.             break;
  336.         case OP_PREDEF:    /* call 'C' function on top of stack */
  337.             {
  338.             typedef int func();
  339.             func *f;
  340.  
  341.             f = (func *)op->data.p;
  342.             stack->i = (*f)(stack);
  343.             stack++;
  344.             }
  345.             break;
  346.         case OP_PREDEFL:    /* call 'C' function on top of stack */
  347.             {
  348.             typedef long lfunc();
  349.             lfunc *f;
  350.  
  351.             f = (lfunc *)op->data.p;
  352.             stack->l = (*f)(stack);
  353.             stack++;
  354.             }
  355.             break;
  356.         case OP_MOVES:    /* move data stack pointer */
  357.             stack += op->data.i;
  358.             break;
  359.         case OP_SPAWN:    /* go spawn a new creature */
  360.             stack[-5].i = go_spawn(stack);
  361.             stack -= 4;
  362.             break;
  363.         case OP_EVOLVE: /* evolve creatures... */
  364.             go_evolve(stack);
  365.             break;
  366.         case OP_KILL:
  367.             --stack;
  368.             go_kill(stack->i);
  369.             break;
  370.         case OP_STATEMENT:    /* statement ops don't do anything... */
  371.             break;
  372.         case OP_FREES:
  373.             clear_frees();
  374.             break;
  375.         }
  376.     op++;
  377.     }
  378. }
  379.  
  380. /* make sure have enough code space */
  381. check_cspace()
  382. {
  383. if (rframe->op_count >= CSZ - 1)  /* some extra space for folding routines*/
  384.     {
  385.     say_fatal("Out of code space");
  386.     return(0);
  387.     }
  388. return(1);
  389. }
  390.  
  391. /* insert code with pointer data */
  392. code_big(type, p)
  393. int type;
  394. void *p;
  395. {
  396. register struct pogo_op *cs;
  397.  
  398. if (check_cspace())
  399.     {
  400.     cs = rframe->code_buf+rframe->op_count;
  401.     cs->type = type;
  402.     cs->data.p = p;
  403.     rframe->op_count++;
  404.     }
  405. }
  406.  
  407. /* insert code with integer data */
  408. code_num(type, con)
  409. int type;
  410. NUMBER con;
  411. {
  412. register struct pogo_op *cs;
  413.  
  414. if (check_cspace())
  415.     {
  416.     cs = rframe->code_buf+rframe->op_count;
  417.     cs->type = type;
  418.     cs->data.p = NULL;
  419.     cs->data.i = con;
  420.     rframe->op_count++;
  421.     }
  422. }
  423.  
  424. code_void(type)
  425. int type;
  426. {
  427. register struct pogo_op *cs;
  428.  
  429. if (check_cspace())
  430.     {
  431.     cs = rframe->code_buf+rframe->op_count;
  432.     cs->type = type;
  433.     cs->data.p = NULL;
  434.     rframe->op_count++;
  435.     }
  436. }
  437.  
  438. /* try to merge a unary operator with a constant */
  439. fold1()
  440. {
  441. struct pogo_op *code;
  442. union pt_int estack[3];
  443. void *result;
  444.  
  445. code = rframe->code_buf + rframe->op_count - 2;
  446. if (code->type == OP_CON)
  447.     {
  448.     code[2].type = OP_END;
  449.     result = run_ops(code, estack);
  450.     code->data.p = result;
  451.     rframe->op_count -= 1;
  452.     }
  453. }
  454.  
  455. code_op1(type)
  456. int type;
  457. {
  458. code_void(type);
  459. fold1();
  460. }
  461.  
  462.  
  463.  
  464. /* try to merge two constants and a binary operator into a single constant*/
  465. fold2()
  466. {
  467. struct pogo_op *code;
  468. union pt_int estack[4];
  469. void *result;
  470.  
  471. code = rframe->code_buf + rframe->op_count - 3;
  472. if (code[0].type == OP_CON && code[1].type == OP_CON)
  473.     {
  474.     code[3].type = OP_END;
  475.     result = run_ops(code, estack);
  476.     code->data.p = result;
  477.     rframe->op_count -= 2;
  478.     }
  479. }
  480.  
  481.  
  482. code_op2(type)
  483. int type;
  484. {
  485. code_void(type);
  486. fold2();
  487. }
  488.  
  489.  
  490. code_arr_var(v)
  491. Symbol *v;
  492. {
  493. int element;
  494.  
  495. if (v->elements == 0)
  496.     code_var(v);
  497. else
  498.     {
  499.     switch (v->scope)
  500.         {
  501.         case GLOBAL:
  502.             if (v->type == STRING)
  503.                 code_num(OP_SARR, (NUMBER)v->doff);
  504.             else if (v->type == INT)
  505.                 code_num(OP_ARR, (NUMBER)v->doff);
  506.             break;
  507.         case LOCAL:
  508.             if (v->type == STRING)
  509.                 code_num(OP_LSARR, (NUMBER)v->doff);
  510.             else if (v->type == INT)
  511.                 code_num(OP_LARR, (NUMBER)v->doff);
  512.             break;
  513.         }
  514.     }
  515. }
  516.  
  517. code_var(v)
  518. Symbol *v;
  519. {
  520. switch (v->scope)
  521.     {
  522.     case GLOBAL:
  523.         if (v->type == STRING)
  524.             code_num(OP_SVAR, v->doff);
  525.         else if (v->type == INT)
  526.             code_num(OP_VAR, (NUMBER)v->doff);
  527.         break;
  528.     case LOCAL:
  529.         if (v->type == STRING)
  530.             code_num(OP_LSVAR, v->doff);
  531.         else if (v->type == INT)
  532.             code_num(OP_LVAR, (NUMBER)v->doff);
  533.         break;
  534.     }
  535. }
  536.  
  537. code_arr_assign(v)
  538. Symbol *v;
  539. {
  540. if (v->elements == 0)
  541.     code_assign(v);
  542. else
  543.     {
  544.     switch (v->scope)
  545.         {
  546.         case GLOBAL:
  547.             if (v->type == STRING)
  548.                 code_num(OP_ASASSIGN, (NUMBER)v->doff);
  549.             else if (v->type == INT)
  550.                 code_num(OP_AASSIGN, (NUMBER)v->doff);
  551.             break;
  552.         case LOCAL:
  553.             if (v->type == STRING)
  554.                 {
  555.                 if (in_creature)
  556.                     code_num(OP_LASASSIGN, (NUMBER)v->doff);
  557.                 else
  558.                     code_num(OP_CASASSIGN, (NUMBER)v->doff);
  559.                 }
  560.             else if (v->type == INT)
  561.                 code_num(OP_LAASSIGN, (NUMBER)v->doff);
  562.             break;
  563.         }
  564.     }
  565. }
  566.  
  567. code_assign(v)
  568. Symbol *v;
  569. {
  570. switch (v->scope)
  571.     {
  572.     case GLOBAL:
  573.         if (v->type == STRING)
  574.             code_num(OP_SASSIGN, (NUMBER)v->doff);
  575.         else if (v->type == INT)
  576.             code_num(OP_ASSIGN, (NUMBER)v->doff);
  577.         break;
  578.     case LOCAL:
  579.         if (v->type == STRING)
  580.             {
  581.             if (in_creature)
  582.                 code_num(OP_CSASSIGN, (NUMBER)v->doff);
  583.             else
  584.                 code_num(OP_LSASSIGN, (NUMBER)v->doff);
  585.             }
  586.         else if (v->type == INT)
  587.             code_num(OP_LASSIGN, (NUMBER)v->doff);
  588.         break;
  589.     }
  590. }
  591.  
  592. /* returns TYPE of last code ... (to see if it's constant maybe... */
  593. top_op()
  594. {
  595. return(rframe->code_buf[rframe->op_count-1].type);
  596. }
  597.  
  598.